perm filename XM.FAI[TMP,LCS] blob
sn#502605 filedate 1980-03-23 generic text, type T, neo UTF8
00100 TITLE XM
00200 ;******** FOR THICKER LINES, FIRST TYPE <4> FOR DOTS*4 OR <9> FOR DOTS*9
00300 ;↓↓AC DEF
00400 A←1
00500 B←2
00600 C←3
00700 D←4
00800 E←5
00900 L←6
01000 U←7
01100 X←11
01200 Y←12
01300 XD←13
01400 T←15
01500 TT←16
01600 P←17
01700
01800 LPDL←←69
01900 NBUFS←←4
02000 DSK←←1
02100 XGP←←2
02200
02300 LMAR←←=0
02400 RMAR←←=1699
02500 WIDTH←←=1700
02600 LBUFL←←=48 ;LINE LENGTH IN WORDS
02700
02800 LSTBIT←←1⊗34
02900
03000 OVERLAP←←=50
03100
03200 DOFF←←-=760
03300
03400 EXTERN JOBREL,JOBFF,JOBTPC,JOBAPR,JOBCNI
03500 MAILBF: BLOCK 40
03600 SIGN: 0
03700 LINE: 0
03800 PNTR: 0
03900
00100 BEG: SETOM LINE
00200 GETLIN LINE ;FOR ERROR PRINTOUT
00300 CALLI
00400 HRRZS LINE ;CLEAR LINE BITS
00500 HRRZI A,CORUP
00600 HRRZM A,JOBAPR
00700 SETOM SSS#
00800 HRRZ A,JOBFF ;RESET CORE WITHOUT A RESET
00900 CORE A,
01000 JRST 4,.
01100
01200 ;FLUSHED BY REG 1-3-76
01300 ; MOVE A,[IPC:20000 ↔ 0]
01400 ; INTENB A,
01500 ;
01600 ;ADDED BY REG:
01700 MOVEI A,20000 ;REG MPV
01800 APRENB A, ;REG ENABLE OLD WAY!
01900
02000 MOVE P,[-LPDL,,PDL-1]
02100 ;Z OUTSTR [ASCIZ /OLD? /]
02200 SETZM BIGBOT#
02300 SETZM GO#
02400 ;NEXT LINE REPLACES FOLLOWING ;Z SECTION.
02500 JRST FILIN ;******* NO 'OLD' FEATURE IN THIS VERSION. ******
02600
02700 ;Z INCHWL E
02800 ;Z CAIE E,"B" ; B FOR BIG BOTTOM MARGIN (200=1")
02900 ;Z CAIN E,"b"
03000 ;Z CAIA
03100 ;Z JRST .+3
03200 ;Z SETOM BIGBOT
03300 ;Z JRST GOGO-1
03400 ;Z CAIE E,"L" ; L FOR LEGAL SIZE
03500 ;Z CAIN E,"l"
03600 ;Z JRST LEGLEG
03700 ;Z CAIE E,"G" ;IF 'G' SKIP ALL PROMPTS
03800 ;Z CAIN E,"g"
03900 ;Z CAIA
04000 ;Z JRST PASS
04100 ;Z PUSHJ P,FRD ;GO GET DEFAULT FILE NAME.
04200 GONEW: PUSHJ P,FRD ;GO GET DEFAULT FILE NAME.
04300 GOGO: MOVEI =11 ;DEFAULT PAGE LENGTH = 11" WITH 'G'
04400 JRST GOGOGO
04500 LEGLEG: PUSHJ P,FRD
04600 LEGAL: MOVEI =14 ;TYPE 'L' FOR LEGAL SIZE 14"
04700 GOGOGO: MOVEM GO
04800 ;;; SETOM GO ;FOR SKIPING ALL PROMPTS
04900 ;C CLRBFI ;INSTEAD OF ↑↑
05000 PUSHJ P,INCHLF
05100 OUTSTR [ASCIZ/USING DEFAULT VALUES.
05200 /]
05300 SETZM ROFLG#
05400 HRREI B,-60 ;??
05500 JRST PASS2
05600 ;ZPASS: CAIE E,"Y"
05700 ;Z CAIN E,"y"
05800 ;Z JRST INBITS
05900 ;Z CLRBFI
06000 SETZM SPREAD#
06100 FILIN: OUTSTR [ASCIZ /FILE? (DEFAULT=PLT.PLT) /]
06200 PUSHJ P,FRD
06300 SKIPE GO
06400 JRST GONEW ;IF 'G' IS NAME THEN USE DEFAULT VALUES.
06500 SETZ A,
06600 YAGN1: HRREI B,-60
06700 SETZM ROFLG
06800 OUTSTR [ASCIZ/ROTATE? /] ;YOU CAN TYPE 'G' FOR GO HERE TOO.
06900 INCHWL E
07000 CAIE E,"Y"
07100 CAIN E,"y"
07200 SETOM ROFLG ;ROTATE FLAG NOW SET =-1
07300 CAIE E,"G"
07400 CAIN E,"g"
07500 JRST GOGO
07600 CAIE E,"L"
07700 CAIN E,"l"
07800 JRST LEGAL
07900 PUSHJ P,INCHLF ;GO LOOK FOR THE LINE FEED
08000 ;C CLRBFI
08100 SKIPN ROFLG ;ROTATE?
08200 JRST .+3 ;NO, SKIP NEXT
08300 OUTSTR [ASCIZ/ORIGIN X RIGHT OFFSET (DEFAULT=7.0(CENTER))? /]
08400 SKIPA
08500 OUTSTR [ASCIZ/ORIGIN X RIGHT OFFSET (DEFAULT=4.0(CENTER))? /]
08600 PUSHJ P,RNUM
08700 JRST [ PASS2: HRREI A,-=760
08800 SKIPE ROFLG ;ROTATE?
08900 HRREI A,-=1400 ; YES, DEFAULT = 7"
09000 JRST YDEF] ;GET Y INFO
09100 IMULI A,=100
09200 CAIN C,"." ;DECIMAL POINT?
09300 JRST [ INCHWL C
09400 CAIN C,15
09500 INCHWL C
09600 CAIL C,"0"
09700 CAILE C,"9"
09800 JRST .+1
09900 SUBI C,60
10000 IMULI C,=10
10100 SKIPE SIGN
10200 MOVN C,C
10300 ADD A,C
10400 PUSH P,A
10500 PUSHJ P,RNUM
10600 JFCL
10700 POP P,A
10800 JRST .+1] ;.+1??
10900 MOVN A,A
11000 LSH A,1 ;*2 (MAKE IT STEPS)
11100 CAIE C,12 ;DID IT GET A LF?
11200 PUSHJ P,INCHLF ;NO, GO LOOK
11300 ;CYDEFP: CAIE C,12
11400 ;C JRST [ CLRBFI
11500 ;C JRST YAGN1]
11600 YDEF: ADD A,B
11700 MOVNM A,INIX#
11800 AGAIN: MOVE A,[FILNAM,,LKENT]
11900 BLT A,LKENT+3
12000 OPEN DSK,[14↔'DSK '↔IBUF]
12100 JRST 4,.
12200 INBUF DSK,NBUFS
12300 LOOKUP DSK,LKENT
12400 JRST FNF
12500 ASKLEN: SETZM POOBX#
12600 SETZM POOBY#
12700 PUSHJ P,XINI ;GET X INFO
12800 SETZM XX#
12900 SETZM YY#
13000 MOVEI C,3
13100 HRRZM C,PENN#
13200 READ1: IN DSK, ;READ FIRST BUFFER
13300 SKIPA
13400 HALT ;ERROR
13500 HRR C,IBUF+1
13600 MOVN E,1(C) ;LOOK FOR SIZE FACTOR. IF FOUND SKIP THIS BUFFER.
13700 CAIGE E,177 ;FIRST WD HAS SIZE * 1000, NOT WDCNT
13800 MOVNI E,177
13900 JRST PLOTX ;IF(E.LT.-177)E=-177
14000
14100 OUTER: IN DSK,
14200 JRST PLOT
14300 STATO DSK,20000
14400 JRST 4,.
14500 RELEAS DSK,
14600 IFN LSTBIT-1,<PUSHJ P,XFIX>
14700 JRST PCUT
14800
14900 INCHLF: INCHWL 0 ;GET ANOTHER CHARACTER
15000 CAIE 0,12 ;WAS IT A LF?
15100 JRST INCHLF ;GET THE LF
15200 POPJ P,
00100 XINI: SKIPN GO
00200 OUTSTR [ASCIZ /LENGTH IN INCHES (Y DIMENSION, DEFAULT=11)? /]
00300 SETZM DEFA#
00400 SKIPE GO
00500 JRST PASSD
00600 PUSHJ P,RNUM
00700 SETOM DEFA ;ASSUME 11 INCHES
00800 ;C JUMPLE A,[XINLER:CLRBFI
00900 ;CC JUMPLE A,[XINLER:PUSHJ P,INCHLF
01000 JUMPLE A,[XINLER:INCHWL 0 ; GET LF?
01100 JRST XINI]
01200 SKIPGE DEFA ;? GO?
01300 PASSD: HRRZI A,=11
01400 SKIPE GO
01500 MOVE A,GO
01600 ;;PASSD: MOVE A,GO ;EITHER 11 OR 14
01700 CAIE C,12
01800 JRST XINLER
01900 IMULI A,=200
02000 PUSH P,A
02100 YINI1: SKIPE GO
02200 JRST PASS3
02300 SKIPL ROFLG
02400 OUTSTR [ASCIZ \ORIGIN Y BOTTOM OFFSET, 200/IN.(DEFAULT=75)? \]
02500 SKIPGE ROFLG
02600 OUTSTR [ASCIZ \ORIGIN Y BOTTOM OFFSET, 200/IN.(DEFAULT=1000)? \]
02700 PUSHJ P,RNUM
02800 PASS3: JRST [ MOVEI A,=75
02900 SKIPE BIGBOT ;BIGBOT=NEG=200 BOTTOM MARGIN
03000 MOVEI A,=200
03100 SKIPGE ROFLG
03200 MOVEI A,=1000
03300 JRST IYDEF]
03400 CAIE C,12
03500 ;C JRST [ CLRBFI
03600 JRST [ PUSHJ P,INCHLF
03700 JRST YINI1]
03800 ;;IYDEF: IMULI A,LBUFL+1
03900 ;; MOVEM A,IYPOS#
04000 IYDEF: MOVEM A,SHIFT#
04100 POP P,A
04200 XDEF: MOVEM A,LINCNT# ;LINCNT NEVER SEEMS TO REAPPEAR!
04300 MOVEI B,-1(A)
04400 IMULI A,LBUFL+1 ;A← BUFSIZ ← ROWS * COL
04500 MOVE T,JOBFF ;GET START ADDR
04600 MOVEM T,XGPPTR
04700 SOS XGPPTR
04800 MOVEI T,2(A)
04900 MOVNI TT,(T)
05000 ADD T,XGPPTR
05100 HRLM TT,XGPPTR ;XGPPTR← -WDCNT,,ADDR-1
05200 MOVE TT,T
05300
05400 HRRZ L,XGPPTR
05500 MOVSI T,1(L)
05600 HRRI T,2(L)
05700 SETZM 1(L)
05800 MOVE U,JOBREL
05900 BLT T,(U) ;ZERO TO END OF CORE
06000 HRRZI U,(TT)
06100 MOVEM B,SVBBB#
06200
06300 ;; MOVE Y,IYPOS
06400 ;; ADDI Y,2(L)
06500 MOVEI Y,2(L)
06600 MOVEI XD,DBUF+1
06700 SKIPL A,INIX ;WHERE DO WE START
06800 JRST MAYBON
06900 SUBI A,43
07000 IDIV A,[-44]
07100 HRLOI X,XD
07200 SOJA A,SETB
07300
07400 MAYBON: ADDI A,43
07500 IDIVI A,44
07600 CAILE A,LBUFL
07700 JRST OFFRT
07800 MOVE X,A
07900 SETZ A,
08000 HRLI X,Y
08100 JRST SETB
08200
08300 OFFRT: MOVE X,[XD,,LBUFL]
08400 SUBI A,LBUFL
08500 SETB: MOVE B,INIX
08600 IDIVI B,44
08700 MOVSI B,400000
08800 MOVN C,C
08900 ROT B,(C)
09000 POPJ P,
09100
09200 POPJ1: AOS (P)
09300 CPOPJ: POPJ P,
09400
00100 MOVE A,E ;ROTATION
00200 ROTA: MOVE 14,2(A)
00300 LSHC 14,-10
00400 HLLZ C,15
00500 LSHC 14,-16
00600 HLLZ D,15
00700 LSHC 14,-16
00800 EXCH 15,D
00900 LSHC 14,16
01000 ASH D,-26
01100 MOVN 15,D
01200 LSH 15,26
01300 LSHC 14,16
01400 HLLZ 15,C
01500 LSHC 14,10
01600 MOVEM 14,2(A)
01700 AOBJN A,ROTA
01800 JRST PLOT1
01900
02000 PLOT: HRR C,IBUF+1
02100 MOVN E,1(C) ;FIX FOR NO WDCNT
02200 PLOTX: MOVSI E,(E)
02300 HRR E,IBUF+1
02400 SKIPGE ROFLG
02500 JRST ROTA-1
02600 PLOT1: MOVE 14,2(E)
02700 LSHC 14,-10
02800 ASH 15,-34
02900 MOVEM 15,SVPEN# ;GET PEN CODE
03000 MOVM A,15
03100 LSHC 14,-16
03200 ASH 15,-26
03300 SKIPL SVPEN
03400 ADD 15,SHIFT ;SHIFT UP OR DOWN
03500 MOVEM 15,SVY# ;GET Y
03600 SUB 15,YY
03700 MOVEM 15,SVYSB# ;SAVE Y DIFF
03800 IMULI 15,LBUFL+1
03900 ADD 15,Y
04000 MOVEM 15,SVYOD# ;SAVE NEW Y
04100 CAIGE 15,(L) ;OFF TOP
04200 JRST LOSE
04300 CAIL 15,-LBUFL-1(U) ;OFF BOTTOM
04400 JRST LOSE
04500 LSHC 14,-16
04600 ASH 15,-26
04700 MOVEM 15,SVX# ;GET X
04800 SUB 15,XX
04900 MOVE 0,15 ;0 HAS X DIFF
05000 HRRZ 16,X
05100 IMULI 16,44 ;TIMES BITS INA WORD
05200 JFFO B,.+1
05300 ADD 16,C ;PLUS REMAINDER EQ OLD X
05400 SUB 16,15
05500 JUMPL 16,LOSEX
05600 CAILE 16,=1727
05700 JRST LOSEX
05800 SKIPE OOBFLG# ;CK IF ALREADY OOB
05900 JRST OOBAR
06000 FIXUP: CAIE A,1 ;FIXUP WHAT?
06100 HRRM A,PENN
06200 HRR A,PENN ;SAME PEN IF 1
06300 CAIN A,3
06400 JRST PENUP ;PENUP IF 3
06500 MOVE C,SVYSB ;Y DIFF
06600 IORM B,@X ;MARK NOW X Y
06700 ;FIND DIRECTION
06800 JUMPE NORMX ;VERT OR NO MOVE
06900 JUMPL MVLFT ;LEFT
07000 JUMPE C,NRT ;HORZ
07100 JUMPL C,MVDWN ;DOWN
07200 CAMLE C,0 ;JUMP IF Y DIFF > X DIFF
07300 JRST XCHA
07400
07500 SETZ 14, ;↓↓ MOVE UP AND RIGHT
07600 TLNE C,200000
07700 JRST .+4
07800 LSH C,1
07900 TRO C,1
08000 AOJA 14,.-4
08100 SUBI 14,=34
08200 IDIV C,0
08300 MOVNS 14
08400 LSH C,(14)
08500 SETZ 15,
08600 INLOOP: ADD 15,C
08700 TLZE 15,200000
08800 ADDI Y,LBUFL+1
08900 SKIPGE B
09000 SOJ X,
09100 ROT B,1
09200 IORM B,@X
09300 SOJG INLOOP
09400 JRST DONXT
09500
00100 XCHA: SETZ 14, ;↓↓MOVE UP AND RIGHT
00200 TLNE 0,200000
00300 JRST .+4
00400 LSH 0,1
00500 TRO 0,1
00600 AOJA 14,.-4
00700 SUBI 14,=34
00800 IDIV 0,C
00900 MOVNS 14
01000 LSH 0,(14)
01100 SETZ 15,
01200 INLOO: ADD 15,0
01300 TLZN 15,200000
01400 JRST MVUP
01500 SKIPGE B
01600 SOJ X,
01700 ROT B,1
01800 MVUP: ADDI Y,LBUFL+1
01900 IORM B,@X
02000 SOJG C,INLOO
02100 JRST DONXT
02200
02300 MVDWN: MOVMS C ;↓↓MOVE DOWN AND RIGHT
02400 CAMLE C,0
02500 JRST XCHA2 ;JUMP IF YDIFF > XDIFF
02600 SETZ 14,
02700 TLNE C,200000
02800 JRST .+4
02900 LSH C,1
03000 TRO C,1
03100 AOJA 14,.-4
03200 SUBI 14,=34
03300 IDIV C,0
03400 MOVNS 14
03500 LSH C,(14)
03600 SETZ 15,
03700 INLOP: ADD 15,C
03800 TLZE 15,200000
03900 SUBI Y,LBUFL+1
04000 SKIPGE B
04100 SOJ X,
04200 ROT B,1
04300 IORM B,@X
04400 SOJG INLOP
04500 JRST DONXT
04600
04700 XCHA2: SETZ 14, ;↓↓MOVE DOWN AND RIGHT
04800 TLNE 0,200000
04900 JRST .+4
05000 LSH 0,1
05100 TRO 0,1
05200 AOJA 14,.-4
05300 SUBI 14,=34
05400 IDIV 0,C
05500 MOVNS 14
05600 LSH 0,(14)
05700 SETZ 15,
05800 INOOP: ADD 15,0
05900 TLZN 15,200000
06000 JRST MVEX
06100 SKIPGE B
06200 SOJ X,
06300 ROT B,1
06400 MVEX: SUBI Y,LBUFL+1
06500 IORM B,@X
06600 SOJG C,INOOP
06700 JRST DONXT
06800
06900 NRT: JUMPL B,GOOP ;HORZ RIGHT
07000 TOOT: ROT B,1
07100 IORM B,@X
07200 SOJG 0,NRT
07300 JRST DONXT
07400 GOOP: SOJ X,
07500 CAIGE 0,44
07600 JRST TOOT
07700 IDIVI 0,44
07800 SETOM @X
07900 SOJ X,
08000 SOJG 0,.-2
08100 HRR 0,1
08200 JUMPN 0,TOOT
08300 AOJ X,
08400 JRST DONXT
08500
08600 NLFT: MOVMS 0 ;HORZ LEFT
08700 ROT B,-1
08800 JUMPL B,ROOT
08900 WOOP: IORM B,@X
09000 SOJG 0,.-3
09100 JRST DONXT
09200 ROOT: AOJ X,
09300 CAIGE 0,44
09400 JRST WOOP
09500 IDIVI 0,44
09600 SETOM @X
09700 AOJ X,
09800 SOJG 0,.-2
09900 HRR 0,1
10000 JUMPN 0,WOOP
10100 SOJ X,
10200 ROT B,1
10300 JRST DONXT
10400 NORMX: JUMPE C,NOMOVE ;NO DIFF
10500 JUMPL C,MDOWN ;MOVE VERT DOWN
10600 MUP: ADDI Y,LBUFL+1 ;MOVE VERT UP
10700 IORM B,@X
10800 SOJG C,MUP
10900 JRST DONXT
11000 MDOWN: SUBI Y,LBUFL+1 ;MOVE VERT DOWN
11100 IORM B,@X
11200 AOJL C,MDOWN
11300 DONXT: MOVE 4,SVX ;DONE. NOW UPDATE X AND Y
11400 MOVEM 4,XX
11500 NXTY: MOVE 4,SVY
11600 MOVEM 4,YY
11700 NOMOVE: SKIPL SVPEN
11800 JRST ENOUT
11900 SETZM XX ;IF NEW LOCO
12000 SETZM YY
12100 ENOUT: AOBJN E,PLOT1 ;GET NEXT
12200 JRST OUTER
12300
00100 MVLFT: MOVMS 0 ;MOVE LEFT THEN RIGHT
00200 MOVMS 15
00300 JUMPE C,NLFT
00400 HRR Y,SVYOD
00500 IDIVI 15,44
00600 ADD X,15
00700 XEND: SOJL 16,DUN
00800 ROT B,-1
00900 JUMPGE B,XEND
01000 AOJ X,
01100 JRST XEND
01200 DUN: MOVEM X,XX ;SAVE NEW X POS
01300 MOVEM B,YY
01400 IORM B,@X
01500 JUMPL C,MVLD
01600 CAMLE C,0
01700 JRST XCHA3
01800 SETZ 14, ;MOVE LEFT UP
01900 TLNE C,200000
02000 JRST .+4
02100 LSH C,1
02200 TRO C,1
02300 AOJA 14,.-4
02400 SUBI 14,=34
02500 IDIV C,0
02600 MOVNS 14
02700 LSH C,(14)
02800 SETZ 15,
02900 ILOOP: ADD 15,C
03000 TLZE 15,200000
03100 SUBI Y,LBUFL+1
03200 SKIPGE B
03300 SOJ X,
03400 ROT B,1
03500 IORM B,@X
03600 SOJG ILOOP
03700 JRST BFOR
03800
03900 XCHA3: SETZ 14,
04000 TLNE 0,200000
04100 JRST .+4
04200 LSH 0,1
04300 TRO 0,1
04400 AOJA 14,.-4
04500 SUBI 14,=34
04600 IDIV 0,C
04700 MOVNS 14
04800 LSH 0,(14)
04900 SETZ 15,
05000 ILOP: ADD 15,0
05100 TLZN 15,200000
05200 JRST DOQ
05300 SKIPGE B
05400 SOJ X,
05500 ROT B,1
05600 DOQ: SUBI Y,LBUFL+1
05700 IORM B,@X
05800 SOJG C,ILOP
05900 JRST BFOR
06000
06100 MVLD: MOVMS C ;MOVE LEFT DOWN
06200 CAMLE C,0
06300 JRST XCHA4
06400 SETZ 14,
06500 TLNE C,200000
06600 JRST .+4
06700 LSH C,1
06800 TRO C,1
06900 AOJA 14,.-4
07000 SUBI 14,=34
07100 IDIV C,0
07200 MOVNS 14
07300 LSH C,(14)
07400 SETZ 15,
07500 LOOP: ADD 15,C
07600 TLZE 15,200000
07700 ADDI Y,LBUFL+1
07800 SKIPGE B
07900 SOJ X,
08000 ROT B,1
08100 IORM B,@X
08200 SOJG LOOP
08300 JRST BFOR
08400
08500 XCHA4: SETZ 14,
08600 TLNE 0,200000
08700 JRST .+4
08800 LSH 0,1
08900 TRO 0,1
09000 AOJA 14,.-4
09100 SUBI 14,=34
09200 IDIV 0,C
09300 MOVNS 14
09400 LSH 0,(14)
09500 SETZ 15,
09600 LOP: ADD 15,0
09700 TLZN 15,200000
09800 JRST DOP
09900 SKIPGE B
10000 SOJ X,
10100 ROT B,1
10200 DOP: ADDI Y,LBUFL+1
10300 IORM B,@X
10400 SOJG C,LOP
10500
10600 BFOR: HRR Y,SVYOD ;RESTORE PEN TO NEW PEN
10700 MOVE X,XX
10800 MOVE B,YY
10900 JRST DONXT
11000
00100 OOBAR: SETZM OOBFLG ; GET HERE IF ALL READY OOB
00200 AOSG SSS ; THIS IS FOR THE FIRST OOB FROM MP
00300 JRST FIXUP ;
00400 PENUP: HRR Y,SVYOD ; PEN IS UP GET NEW Y
00500 JUMPE 15,NXTY ;IF VERT
00600 JUMPL 15,PULFT ;IF LEFT
00700 CAIGE 15,44 ;↓↓MOVE UP PEN RIGHT TO NEW X
00800 JRST XLOOP
00900 IDIVI 15,44
01000 SUB X,15
01100 HRR 15,16
01200 XLOOP: SOJL 15,DONXT
01300 SKIPGE B
01400 SOJ X,
01500 ROT B,1
01600 JRST XLOOP
01700
01800 PULFT: MOVMS 15 ;↓↓MOVE UP PEN LEFT TO NEW X
01900 CAIGE 15,44
02000 JRST OOO
02100 IDIVI 15,44
02200 ADD X,15
02300 HRR 15,16
02400 OOO: SOJL 15,DONXT
02500 ROT B,-1
02600 JUMPGE B,OOO
02700 AOJ X,
02800 JRST OOO
02900
03000 LOSEX: SETOM OOBFLG ;OOB X
03100 SKIPE POOBX
03200 JRST PENUP
03300 SETOM POOBX
03400 PUSHJ P,DETCHK
03500 PUSHJ P,XERR
03600 PUSHJ P,ERRPNT
03700 ASCIZ /POINT OUT OF BOUNDS, /
03800 JUMPL 16,[PUSHJ P,ERRPNT
03900 ASCIZ/-X/
04000 JRST PENUP]
04100 PUSHJ P,ERRPNT
04200 ASCIZ/+X/
04300 JRST PENUP
04400
04500 LOSE: SETOM OOBFLG ;OOB Y
04600 SKIPE POOBY
04700 JRST LOBAC
04800 SETOM POOBY
04900 PUSHJ P,DETCHK
05000 PUSHJ P,XERR
05100 PUSHJ P,ERRPNT
05200 ASCIZ /POINT OUT OF BOUNDS, /
05300 CAIGE 15,(L)
05400 JRST [ PUSHJ P,ERRPNT
05500 ASCIZ/-Y/
05600 JRST LOBAC]
05700 PUSHJ P,ERRPNT
05800 ASCIZ/+Y/
05900 LOBAC: LSHC 14,-16
06000 ASH 15,-26
06100 MOVEM 15,SVX
06200 SUB 15,XX
06300 JRST PENUP
06400
06500 DECOUT: IDIVI T,=10 ;DEC TTY OUT
06600 HRLM TT,(P)
06700 SKIPE T
06800 PUSHJ P,DECOUT
06900 HLRZ TT,(P)
07000 ADDI TT,60
07100 ROT TT,-7
07200 MOVEM TT,.+2
07300 PUSHJ P,ERRPNT
07400 0
07500 POPJ P,
07600
07700 ERRPNT: HRRZ TT,(P) ;ERROR TTY OUT
07800 MOVEM TT,PNTR
07900 MOVEI TT,LINE
08000 TTYMES TT,
08100 JRST [ OUTSTR[ASCIZ/TTYMES FAILED /]
08200 OUTSTR @PNTR
08300 OUTSTR[ASCIZ/
08400 /]
08500 JRST .+1]
08600 POP P,TT
08700 HRL TT,(TT)
08800 TLNE TT,376
08900 AOJA TT,.-2
09000 JRST 1(TT)
09100
09200 XERR: PUSHJ P,ERRPNT ;DET TTY OUT
09300 ASCIZ/
09400 MESSAGE FROM X WORKING ON /
09500 MOVE TT,FILNAM
09600 PUSHJ P,SIXOUT
09700 PUSHJ P,ERRPNT
09800 ASCIZ/./
09900 HLLZ TT,FILEXT
10000 PUSHJ P,SIXOUT
10100 PUSHJ P,ERRPNT
10200 ASCIZ/[/
10300 MOVE TT,FILPPN
10400 PUSHJ P,SIXOUT
10500 PUSHJ P,ERRPNT
10600 ASCIZ/] : /
10700 POPJ P,
10800
10900 SIXOUT: JUMPE TT,CPOPJ ;SIXBIT OUT
11000 SETZ T,
11100 LSHC T,6
11200 ADDI T,40
11300 PUSH P,TT
11400 ROT T,-7
11500 MOVEM T,.+2
11600 PUSHJ P,ERRPNT
11700 0
11800 POP P,TT
11900 JRST SIXOUT
12000
12100 DETCHK: SETOM DET# ;CK FOR DET JOB
12200 GETLIN DET
12300 HRRES DET
12400 SKIPL DET
12500 AOS (P)
12600 POPJ P,
12700
00100 FINDL: HRRZ A,JOBREL ;CK IF BIG ENUF
00200 CAIL A,-LBUFL-1(U)
00300 JRST XINL-1
00400 XL2: MOVEM TT,(T) ;ADD MORE AND MARK
00500 ADDI T,LBUFL+1
00600 CAIGE T,(A)
00700 JRST XL2
00800 SUBI A,(L)
00900 MOVNS A
01000 HRLM A,XGPPTR
01100 SUBI T,LBUFL+1
01200 JRST XXOUT
01300
01400 PCUT: HRRZ L,XGPPTR ;MARK BLOCK FOR XGP
01500 MOVE TT,[BYTE (12)4001,LMAR,LBUFL]
01600 MOVEM TT,1(L) ;FIRST ONE HAS MARK AND CUT WITH IT
01700 TLZ TT,400000 ;DELETE MARK AND CUT
01800 MOVEI T,1+LBUFL+1(L)
01900 SKIPGE DEFA
02000 JRST FINDL
02100 MOVE B,SVBBB
02200 XINL: MOVEM TT,(T)
02300 ADDI T,LBUFL+1
02400 SOJG B,XINL
02500 HLRO TT,XGPPTR
02600 MOVNS TT
02700 ADDI TT,(L)
02800 MOVE A,(TT)
02900 XXOUT: MOVSI TT,400100
03000 MOVEM TT,(T) ;SO DOES LAST
03100
03200 SKIPN SPREAD
03300 JRST XGPOUT
03400
03500 HRRZ T,XGPPTR
03600 ADDI T,LBUFL+1
03700 HRRZ C,SVBBB
03800
03900 SKIPG SPREAD
04000 JRST NINE
04100
04200 XLINE4: HRLI T,-LBUFL
04300
04400 XSHFT4: MOVE A,2(T)
04500 MOVE B,3(T)
04600 ROTC A,1
04700 ORM A,2(T)
04800 AOBJN T,XSHFT4
04900 AOJ T,
05000 SOJG C,XLINE4
05100
05200 HRRZ T,XGPPTR
05300 HRRZ B,SVBBB
05400
05500 YLINE4: HRLI T,-LBUFL
05600
05700 YSHFT4: MOVE A,LBUFL+3(T)
05800 ORM A,2(T)
05900 AOBJN T,YSHFT4
06000 AOJ T, ;Bump past control word.
06100 SOJG B,YLINE4
06200
06300 JRST XGPOUT
06400
06500 NINE: HRLI T,-LBUFL
06600
06700 XSHFT9: MOVE A,2(T)
06800 MOVE B,3(T)
06900 ROTC A,1
07000 ORM A,2(T)
07100 ROTC A,1
07200 ORM A,2(T)
07300 AOBJN T,XSHFT9
07400 AOJ T,
07500 SOJG C,NINE
07600
07700 HRRZ T,XGPPTR
07800 HRRZ B,SVBBB
07900
08000 YLINE9: HRLI T,-LBUFL
08100
08200 YSHFT9: MOVE A,LBUFL+LBUFL+4(T)
08300 OR A,LBUFL+3(T)
08400 ORM A,2(T)
08500 AOBJN T,YSHFT9
08600 AOJ T,
08700 SOJG B,YLINE9
08800
08900 XGPOUT: OPEN XGP,XNIT ;XGP OUTPUT
09000 ;;; PUSHJ P,NOXGP
09100 JRST NOXGP
09200 OUTSTR[ASCIZ/CRANKING XGP
09300 /]
09400 LOCK
09500 OUTIT: OUT XGP,XGPPTR
09600 JRST OUTOK
09700 DSKERR: PUSHJ P,DETCHK
09800 PUSHJ P,XERR
09900 PUSHJ P,ERRPNT
10000 ASCIZ /XGP OUTPUT ERROR.
10100 /
10200 OUTOK: UNLOCK
10300 RELEAS XGP,
10400 XMORE: PUSHJ P,DETCHK
10500 ;; JRST DODEL ;DELETE AUTOMATICALLY IF DETACHED
10600 JFCL
10700 OUTSTR[ASCIZ/D=DELETE, R=REPEAT, X=EXIT /]
10800 INCHRW C
10900 CAIE C,15
11000 JRST .+3
11100 INCHRW C
11200 JRST XMORE+2 ; WON'T ACCEPT JUST CRLF
11300 OUTSTR[ASCIZ/
11400 /]
11500 CAIE C,"X"
11600 CAIN C,"x"
11700 SKIPA
11800 JRST .+3
11900 PUSHJ P,CORDWN ;REALLY DONE, CORE DOWN
12000 JRST NODEL
12100 CAIE C,"R"
12200 CAIN C,"r"
12300 JRST XGPOUT
12400 CAIE C,"D"
12500 CAIN C,"d"
12600 SKIPA ;IF NOT R, X OR D TRY AGAIN.
12700 JRST XMORE+2
12800 PUSHJ P,CORDWN ;REALLY DONE, CORE DOWN
12900 DODEL: MOVE A,[FILNAM,,LKENT]
13000 BLT A,LKENT+3
13100 INIT DSK,17
13200 'DSK '
13300 0
13400 JRST [ SKIPGE DET
13500 PUSHJ P,XERR
13600 PUSHJ P,ERRPNT
13700 ASCIZ/COULDN'T GET DISK FOR DELETE!
13800 /
13900 JRST NODEL]
14000 LOOKUP DSK,LKENT
14100 JRST [ SKIPGE DET
14200 PUSHJ P,XERR
14300 PUSHJ P,ERRPNT
14400 ASCIZ/LOOKUP FOR DELETE FAILED!
14500 /
14600 JRST NODEL]
14700 MOVE A,FILPPN
14800 MOVEM A,LKENT+3
14900 SETZM LKENT
15000 RENAME DSK,LKENT
15100 CAIA
15200 JRST NODEL
15300 SKIPGE DET
15400 PUSHJ P,XERR
15500 PUSHJ P,ERRPNT
15600 ASCIZ/RENAME FOR DELETE FAILED!
15700 /
15800 NODEL: RELEASE DSK,
15900 SKIPGE DET
16000 PUSHJ P,XERR
16100 PUSHJ P,ERRPNT
16200 ASCIZ/ALL DONE!
16300 /
16400 CALLI 12 ;LEAVE
16500
16600 NOXGP: PUSHJ P,DETCHK
16700 PUSHJ P,XERR
16800 PUSHJ P,ERRPNT
16900 ASCIZ /
17000 WAITING FOR XGP /
17100 ;ZZ ASCIZ /
17200 ;ZZXGP BUSY, OUTPUT TO DISK? /
17300 ;ZZ INCHRW A
17400 ;ZZ CAIE A,"Y"
17500 ;ZZ CAIN A,"y"
17600 ;ZZ JRST OUTFIL
17700 HRRZI A,1017
17800 HRRZM A,XNIT
17900 ;;; POPJ P,
18000 JRST XGPOUT
18100
18200 XNIT: 417
18300 'XGP '
18400 0
18500 XGPPTR: BLOCK 2
18600
18700 IFN LSTBIT-1,<
18800 XFIX: MOVE A,[LSTBIT-1]
18900 HRRZ C,JOBREL
19000 HRRZ D,XGPPTR
19100 XFIXL: ANDCAM A,LBUFL-1+2(D)
19200 ADDI D,LBUFL+1
19300 CAIGE D,(C)
19400 JRST XFIXL
19500 POPJ P,
19600 >
19700 CORDWN: MOVE T,JOBFF
19800 SUBI T,1
19900 CALLI T,11
20000 JRST 4,.
20100 POPJ P,
20200
00100 INBITS: PUSHJ P,NAMGET ;INPUT OLD BIT FILE
00200 HRRZ U,JOBFF
00300 HRRZI T,177(U)
00400 CORE T,
00500 JRST INBITS
00600 SOJ U,
00700 HRLI U,-200
00800 OPEN [17↔'DSK '↔0]
00900 JRST INBITS
01000 LOOKUP FILNAM
01100 JRST INBITS
01200 SETZ 10,
01300 TRYTRY: OPEN XGP,XNIT ;***** GRAB THE XGP BEFORE CORE EXPANSION
01400 JRST NONO ;CAN'T GET IT!
01500 INPUT U
01600 MOVE T,[BYTE (12)4001,LMAR,LBUFL]
01700 EXCH T,1(U)
01800 HLL U,T
01900 MOVEM U,XGPPTR
02000 HRLI U,(T)
02100 TLNN U,777777
02200 JRST CLOZE
02300 ADDI U,200
02400 MOVNI T,(T)
02500 ADDI T,(U)
02600 CORE T,
02700 JRST INBITS ;HANG
02800 INPUT U
02900 CLOZE: RELEAS
03000 JRST XGPOUT
03100
03200 NONO: OUTSTR[ASCIZ/
03300 WAITING FOR XGP /]
03400 HRRZI A,1017
03500 HRRZM A,XNIT
03600 JRST TRYTRY
03700
03800 OUTFIL: PUSHJ P,NAMGET ;OUTPUT BIT FILE
03900 MOVE U,XGPPTR
04000 HLRO T,U
04100 MOVNS T
04200 TRZ T,177
04300 HRRZI A,200(T)
04400 ADDI A,(U)
04500 CORE A,
04600 JRST OUTFIL
04700 MOVNS T
04800 HLL T,U ;FIRST WD IS WC-200,-WC
04900 MOVEM T,1(U)
05000 HRLI U,-200(T)
05100 SETZ 10,
05200 OPEN [17↔'DSK '↔0]
05300 JRST 4,.
05400 ENTER FILNAM
05500 CAIA
05600 OUTPUT U
05700 RELEAS
05800 JRST NODEL
05900
00100 ;CORUP
00200
00300 CORUP:
00400
00500 REPEAT 0,< OLD WAY - FLUSHED BY REG 1-3-76
00600
00700 HRRZ B,JOBCNI
00800 CAIE B,20000
00900 DISMIS
01000 MOVE A,JOBTPC
01100 MOVEM A,IPC+1
01200 UWAIT
01300 DEBREAK
01400 >;END REPEAT 0
01500
01600 BUST: MOVEM 1,SVONE#
01700 MOVEM 2,SVTWO#
01800 MOVEM TT,SVTTT#
01900 MOVE 1,JOBCNI ;REG GET APR CONI BITS
02000 TRNN 1,20000 ;REG IS THERE AN MPV?
02100 JRST NOMPV ;REG NO
02200 HRRZ 1,JOBREL ;OLD CORE SIZE
02300 MOVSI 2,1(1) ;FIRST NEW WORD WE'LL GET
02400 HRRI 2,2(1) ;SECOND NEW WORD - 2 HAS A BLT POINTER.
02500 ADDI 1,16000
02600 ;; ADDI 1,10000 ;GET ANOTHER 8K
02700 MOVE TT,1
02800 CORE 1,
02900 PUSHJ P,CORLUZ
03000 HRRZ 1,JOBREL
03100 SETZM -1(2)
03200 BLT 2,(1) ;ZERO NEW CORE
03300 MOVE 1,SVONE
03400 MOVE 2,SVTWO
03500 MOVE TT,SVTTT
03600
03700 REPEAT 0,<
03800 INTJEN IPC
03900 >
04000
04100 JRST 2,@JOBTPC ;REG THIS IS HOW TO DISMISS OLD INTERRUPT
04200
04300 NOMPV: OUTSTR [ASCIZ/UNEXPECTED INTERRUPT?
04400 /]
04500 JRST 2,@JOBTPC
04600
04700 CORLUZ: MOVE T,TT
04800 LSH T,-12
04900 PUSH P,T
05000 PUSHJ P,DETCHK
05100 PUSHJ P,XERR
05200 POP P,T
05300 PUSHJ P,DECOUT
05400 PUSHJ P,ERRPNT
05500 ASCIZ / K OF CORE NEEDED!
05600 /
05700 SKIPGE DET
05800 CALLI 12
05900 JRST ASKLEN
06000
06100 FNF: PUSHJ P,DETCHK ;FILE NOT FOUND
06200 PUSHJ P,XERR
06300 PUSHJ P,ERRPNT
06400 ASCIZ /LOOKUP FAILED.
06500 /
06600 SKIPGE DET
06700 CALLI 12
06800 JRST FILIN
06900
00100 ;******** TYPE '4' FOR 4X4 DOTS, TYPE '9' FOR 9X9 DOTS.***********
00200
00300 FRD: MOVSI A,'PLT' ;FILE SCAN
00400 MOVEM A,FILEXT
00500 SKIPN GO
00600 JRST .+3 ;GO?
00700 MOVEI C,12 ; CR
00800 JRST .+3
00900 PUSHJ P,GETNAM
01000 CAME A,[SIXBIT/G/] ;G ALONE = 'GO'
01100 JRST GOX
01200 SETOM GO ;GO BACK AND USE DEFAULT NAME.
01300 POPJ P,
01400
01500 ;;GOX: CAME A,[SIXBIT/:/] ;FOR * FOUR
01600 GOX: CAME A,[SIXBIT/4/] ;FOR * FOUR
01700 JRST CKSEMI
01800 AOS SPREAD
01900 POPBAC: POP P,A
02000 PUSHJ P,INCHLF
02100 ;C CLRBFI
02200 JRST FILIN
02300 CKSEMI: CAME A,[SIXBIT/9/] ;FOR * NINE
02400 ;;CKSEMI: CAME A,[SIXBIT/;/]
02500 JRST CKDEFA
02600 SETOM SPREAD
02700 JRST POPBAC
02800 CKDEFA: SKIPN A
02900 MOVE A,['PLT ']
03000 MOVEM A,FILNAM
03100 CAIE C,"."
03200 JRST NOEXT
03300 PUSHJ P,GETNAM
03400 MOVEM A,FILEXT
03500 NOEXT: CAIE C,"["
03600 JRST FRDX
03700 PUSHJ P,GETP
03800 HRLZM A,FILPPN
03900 PUSHJ P,GETP
04000 HRRM A,FILPPN
04100 FRDX: SKIPN GO
04200 INCHRW C
04300 CAIE C,12
04400 JRST FRDX
04500 POPJ P,
04600
04700 RNUM: INCHWL C ;NUM SCAN
04800 CAIN C,15
04900 JRST RNUM
05000 CAIN C,12
05100 POPJ P,
05200 AOS (P)
05300 MOVEI A,
05400 SETZM SIGN
05500 CAIN C,"-"
05600 JRST [ PUSHJ P,RNUML
05700 SETOM SIGN
05800 MOVN A,A
05900 POPJ P,]
06000 CAIN C,"+"
06100 RNUML: INCHWL C
06200 CAIL C,"0"
06300 CAILE C,"9"
06400 JRST RNUMX
06500 IMULI A,12
06600 ADDI A,-"0"(C)
06700 JRST RNUML
06800
06900 RNUMX: CAIN C,15
07000 INCHRW C
07100 POPJ P,
07200
00100 GETNAM: MOVEI A, ;FILE SCAN
00200 MOVE B,[440600,,A]
00300 GETNML: PUSHJ P,RCH
00400 POPJ P,
00500 SUBI C,40
00600 TLNE B,770000
00700 IDPB C,B
00800 JRST GETNML
00900
01000 GETP: MOVEI A,
01100 GETPL: PUSHJ P,RCH
01200 POPJ P,
01300 TRNE A,770000
01400 JRST GETPL
01500 LSH A,6
01600 ADDI A,-40(C)
01700 JRST GETPL
01800
01900 RCH: INCHWL C
02000 CAIN C,42
02100 JRST RCHQ
02200 CAIE C,11
02300 CAIN C," "
02400 JRST RCH
02500 CAIE C,"."
02600 CAIN C,","
02700 POPJ P,
02800 CAIE C,"["
02900 CAIN C,"]"
03000 POPJ P,
03100 RCHQR: CAIGE C,40
03200 POPJ P,
03300 CAIL C,"a"
03400 CAILE C,"z"
03500 CAIA
03600 SUBI C,40
03700 JRST POPJ1
03800
03900 RCHQ: INCHWL C
04000 JRST RCHQR
04100
04200 ;CNAMGET: CLRBFI
04300 ;CCNAMGET: INCHWL 0
04400 ;CC INCHWL 0 ;GET CRLF
04500 ;CC INCHWL 0
04600 ;CC INCHWL 0 ;GET CRLF
04700 NAMGET: PUSHJ P,INCHLF
04800 OUTSTR [ASCIZ/
04900 FILE = /]
05000 SETZM FILEXT+1
05100 SETZM FILPPN
05200 MOVSI A,'BIT'
05300 MOVEM A,FILEXT
05400 PUSHJ P,GETNAM
05500 SKIPN A
05600 MOVE A,['PLT ']
05700 MOVEM A,FILNAM
05800 CAIE C,"."
05900 JRST NOEXTN
06000 PUSHJ P,GETNAM
06100 MOVEM A,FILEXT
06200 NOEXTN: CAIE C,"["
06300 JRST FFDX
06400 PUSHJ P,GETP
06500 HRLZM A,FILPPN
06600 PUSHJ P,GETP
06700 HRRM A,FILPPN
06800 FFDX: INCHRW C
06900 CAIE C,12
07000 JRST FFDX
07100 POPJ P,
07200
00100 FILNAM: 0 ;GLOPS OF JUNK
00200 FILEXT: 0
00300 0
00400 FILPPN: 0
00500
00600 LKENT: BLOCK 4
00700
00800 XGSNAM: 0
00900 XGSEXT: 0
01000 0
01100 XGSPPN: 0
01200
01300 IBUF: BLOCK 3
01400
01500 BITTAB: FOR I←43,0,-1{1⊗I
01600 }
01700 BYTTAB: FOR I←36,0,-6{REPEAT 6,{77⊗I}}
01800
01900 DBUF: BLOCK LBUFL+2
02000
02100 PDL: BLOCK LPDL
02200
02300 END BEG